 page
*
newline ldy #c.isnewl ;adjust newline status for open file.
 lda (par),y ;on or off?
 ldx fcbptr ;it will be zero if off. 
 sta fcb+fcbnlmsk,x ;set new line mask 
 iny 
 lda (par),y ;and move in new 'new-line' byte.
 sta fcb+fcbnewl,x 
 clc
 rts ;no error possible.
*
 page
*
getinfo jsr findfile ;look for file they want ot know about.
 bcc gtinfo1 ;branch if no errors.
 cmp #badpath ;was it a root directory file?
 sec ;(in case of no match)
 bne ginfoerr
 lda #$f0
 sta dfil+d.stor ;for get info, report proper storage type
 lda #0 ;force a count of free blocks.
 sta reql
 sta reqh
 ldx vcbptr
 jsr tkfrecnt ;take a fresh count of free blocks on this volume. 
 ldx vcbptr 
 lda vcb+vcbtfre+1,x ;return total blocks and total in use.
 sta reqh ;first transfer 'free' blocks to zpage for later subtract
 lda vcb+vcbtfre,x ; to determine the 'used' count
 sta reql
 lda vcb+vcbtblk+1,x ;transfer to 'd.' table as aux i.d.
 sta dfil+d.auxid+1 ;(total block count is considered aux i.d. for the volume)
 pha 
 lda vcb+vcbtblk,x 
 sta dfil+d.auxid 
 sec ;now subtract and report the number of blocks 'in use'
 sbc reql
 sta dfil+d.usage
 pla 
 sbc reqh
 sta dfil+d.usage+1
gtinfo1 lda dfil+d.stor ;transfer bytes from there internal order to call spec 
 lsr a ; via 'inftabl' translation table. 
 lsr a 
 lsr a ;but first change storage type to 
 lsr a ; external (low nibble) format. 
 sta dfil+d.stor 
 ldy #c.cretime+1 ;index to last of users spec table. 
gtinfo2 lda inftabl-3,y 
 and #$7f ;strip bit used by setinfo
 tax
 lda dfil,x ;move directory info to call spec. table. 
 sta (par),y 
 dey 
 cpy #c.attr ;have all info bytes been sent? 
 bcs gtinfo2 ;branch if not. 
 clc ;indicate no errors
ginfoerr rts
 page
*
setinfo jsr findfile ;find what user wants...
 bcs sinfoerr ;return any failure.
 lda bubit ;discover if backup bit can be cleared.
 eor #$20
 and dfil+d.attr
 and #$20
 sta bkbitflg ;or preserve current...
 ldy #c.modtime+1 ;init pointer to user supplied list.
setinf1 ldx inftabl-3,y ;get index into coresponding 'd.' table
 bmi setinf2 ;branch if we've got a non setable parameter. 
 lda (par),y
 sta dfil,x
setinf2 dey ;has user's request been satisfied?
 cpy #c.attr 
 bcs setinf1 ;no, move next byte.
* 
 and #$18 ;make sure no illegal access bits were set! 
 beq setinf3 ;branch if legal access 
 lda #accserr ;otherwise, refuse to do it.
 sec ;indicate error. 
sinfoerr rts 
* 
setinf3 ldy #c.moddate+1
 lda (par),y ;was clock nul input?
 beq setinf4
 jmp drevise1 ;end by updating directory. 
*
setinf4 jmp drevise ;update with clock also...
* 
 page
*
rename jsr lookfile ;look for source (original) file.
 bcc rname0 ;branch if found.
 cmp #badpath ;trying to rename a volume?
 bne rnmeror ;no, return other error.
 jsr renpath ;syntax new name.
 bcs rnmeror
 ldy pathbuf ;find out if only rootname for new name
 iny 
 lda pathbuf,y ;must be $ff if v-name only
 bne rnbadpth ;branch if not single name.
 ldx vcbptr ;text for open files before changing.
 lda vcb+vcbstat,x
 bpl rnamevol ;branch if volume not busy
 lda #filbusy
rnmeror sec
 rts 
rnamevol ldy #0 ;get newname's length.
 lda pathbuf,y
 ora #$f0 ;(root file storage type)
 jsr mvrotnam ;update root directory.
 bcs rnamerr
 ldy #0
 ldx vcbptr ;update vcb also.
rnmevol lda pathbuf,y ;move new name to vcb. 
 beq rnmevol1 
 sta vcb,x 
 iny ;bump to next character. 
 inx 
 bne rnmevol ;branch alwasy taken. 
rnmevol1 clc ;no errors
 rts
*
rname0 jsr getnamptr ;set y to first char of path, x=0
rname1 lda pathbuf,y ;move original name to gbuf
 sta gbuf,x ; for later comparison with new name.
 bmi rname2 ;branch if last character has been moved.
 iny ;otherwise, get the next one.
 inx
 bne rname1 ;branch always taken.
*
 page
rname2 jsr renpath ;get new name syntaxed.
 bcs rnamerr
 jsr getnamptr ;set y to path, x to 0
 lda pathbuf,y ;now compare new name with old name
rname3 cmp gbuf,x ; to make sure that they are in the same directory.
 php ;save result of compare for now,
 and #$f0 ;was last char really a count?
 bne rname4 ;branch if not.
 sty rnptr ;save pointer to next name, it might be the last.
 stx pnptr
rname4 plp ;what was the result of the compare?
 bne rname5 ;branch if different character or count.
 inx ;bump pointers.
 iny
 lda pathbuf,y ;was that the last character?
 bne rname3 ;branch if not.
 clc ;no-operation, names were the same.
 rts
*
rname5 ldy rnptr ;index to last name in the chains.
 lda pathbuf,y ;get last name length.
 sec
 adc rnptr
 tay
 lda pathbuf,y ;this byte should be $00!
 bne rnbadpth ;branch if not.
 ldx pnptr ;index to last of original name.
 lda gbuf,x
 sec
 adc pnptr
 tax
 lda gbuf,x ;this byte should also be $00 
 beq rname6 ;continue processing if it is.
*
rnbadpth lda #badpath
rnamerr sec
 rts ;report error.
*
rname6 jsr lookfile ;test for duplicate file name.
 bcs rname7 ;branch if file not found, which is what we want!
 lda #duperr ;new name already exists.
 sec ;report duplicate. 
 rts
 page 
rname7 cmp #fnferr ;was it a valid file not found?
 bne rnamerr ;no, return other error code.
 jsr setpath ;now syntax the pathname of the file to be changed.
 jsr findfile ;get all the info on this one.
 bcs rnamerr
 jsr tstopen ;don't allow rename to occur if file is in use.
 lda #filbusy ;anticipate error
 bcs rnamerr
 lda dfil+d.attr ;test bit that says it's ok to rename
 and #renamen
 bne rname8 ;branch if it's alright to rename.
 lda #accserr ;otherwise report illegal access.
rname10 sec
 rts
*
rname8 equ *
 lda dfil+d.stor ;find out which storage type.
 and #$f0 ;strip off name length.
 cmp #dirtyp*16 ;is it a directory? 
 beq rname11
 cmp #tretyp+1*$10 ;is it a seed, sapling, or tree?
 bcc rname11 
 lda #cpterr 
 bne rname10
rname11 jsr renpath ;well... since both names would go into the
 bcs rnamerr ; directory, re-syntax the new name to get local name address.
 ldy rnptr ;(y contains index to local name length)
 ldx pathbuf,y ;adjust y to last char of new name. 
 tya 
 adc pathbuf,y
 tay
rname9 lda pathbuf,y ;move local name to dir entry workspace.
 sta dfil+d.stor,x 
 dey
 dex
 bne rname9 
 lda dfil+d.stor ;preserve file storage type.
 and #$f0 ;strip off old name length.
 tax
 ora pathbuf,y ;add in new name's length
 sta dfil+d.stor
 cpx #dirtyp*16 ; that file must be changed also.
 bne rnamdone ;branch if not directory type.
 page
 lda dfil+d.frst ;read in 1st (header) block of sub-dir
 ldx dfil+d.frst+1
 jsr rdblk
 bcs rnamerr ; report errors
 ldy rnptr ;change the header's name to match the owner's new name.
 lda pathbuf,y ; get local name length again 
 ora #hedtyp*16 ;assume it's a header.
 jsr mvrotnam 
 bcs rnamerr
rnamdone jmp drevise1 ;end by updating all path directories
*
*
mvrotnam ldx #0 
mvhednam sta gbuf+4,x 
 inx 
 iny 
 lda pathbuf,y
 bne mvhednam
 jmp wrtgbuf ;write changed header block.
*
*
renpath ldy #c.nwpath ;get address to new pathname.
 lda (par),y
 iny
 sta tpath
 lda (par),y ;set up for syntaxing routine (synpath).
 sta tpath+1
 jmp synpath ;go syntax it. (returns last local name length in y).
*
getnamptr ldy #0 ;return pointer to first name of path.
 bit prfxflg ;is this a prefixed name?
 bmi getnptr ;branch if not.
 ldy newpfxptr
getnptr ldx #0
 rts
*
 page
*
destroy jsr findfile ;look for file to be wiped out.
 bcs desterr ;pass back any error.
 jsr tstopen ;is this file open?
 lda totent
 bne desterr1 ;branch if file open.
*
dstroy1 lda #0 ;force proper free count in volume.
 sta reql ;(no disk access occurs if already proper)
 sta reqh
 jsr tsfrblk
 bcc dstroy2
 cmp #ovrerr ;was it just a full disk?
 bne desterr ;nope, report error.
*
dstroy2 lda dfil+d.attr ;make sure it's ok to destroy this file.
 and #dstroyen
 bne dstroy3 ;branch if ok.
 lda #accserr ;tell user it's not kosher.
 jsr syserr ;(returns to caller of destory)
*
dstroy3 lda devnum 
 jsr twrprot1 ;before going thru deallocation, 
 bcs desterr ; test for write protected hardware.
 lda dfil+d.frst ;"detree" needs first block addr.
 sta firstbl
 lda dfil+d.frst+1
 sta firstbh
 lda dfil+d.stor ;find out which storage type.
 and #$f0 ;strip off name length.
 cmp #tretyp+1*$10 ;is it a seed, sapling, or tree?
 bcc dstree ;branch if it is.
 jmp dstdir ;otherwise test for directory destroy.
*
desterr1 lda #filbusy
desterr sec ;inform user that file can't be destroyed at this time.
 rts
*
 page
dstree equ * ;destroy a tree file.
 sta stortype ;save storage type.
 ldx #5
 lda #0 ;set "detree" input variables
dstre1 sta stortype,x ;variables must be  
 dex ; in order:deblock, dtree, dsap, dseed
 bne dstre1 ;loop until all set to zero.
 lda #2
 sta dseed+1 ;this avoids an extra file i/o.
*
********************** see rev note #73 **********************
********************* see rev note #49 **********************
********************** see rev note #41 *********************
*
 inc delflag ; don't allow detree to zero index blocks.
 jsr detree ;make trees and saplings into seeds
 dec delflag ; reset flag.
**************************************************************
 bcs desterr ;(de-evolution).
dstlast ldx firstbh
 lda firstbl ;now deallocate seed.
 jsr dealloc
 bcs desterr
*
 lda #0 ;update directory to free entry space.
 sta dfil+d.stor
 cmp h.fcnt ; file entry wrap?
 bne dst1 ; branch if no carry adjustment
 dec h.fcnt+1 ; take carry from high byte of file entries
dst1 dec h.fcnt ; mark header with one less file
* 
 jsr upbmap 
 bcs desterr
 jsr dvcbrev ;go update block count in vcb.
 jmp drevise ;update directory last...
*
*
dvcbrev ldy vcbptr 
 lda deblock 
 adc vcb+vcbtfre,y 
 sta vcb+vcbtfre,y ;update current free block count.
 lda deblock+1 
 adc vcb+vcbtfre+1,y
 sta vcb+vcbtfre+1,y 
 lda #0 ;force rescan from first bitmap
 sta vcb+vcbcmap,y 
 rts
*
*
 page
*
dstdir cmp #dirtyp*16 ;is this a directory file?
 bne drcpterr ;no, report file incompatable. 
*
dsdir1 jsr fndbmap ;make sure a buffer is available for the bitmap.
 bcs dsdirerr
 lda dfil+d.frst ;read in first block of directory into gbuf.
 sta bloknml
 lda dfil+d.frst+1
 sta bloknmh
 jsr rdgbuf
 bcs dsdirerr
 lda gbuf+hcent+4 ;find out if any files exist on this directory.
 bne dsdiracc ;branch if any exist.
 lda gbuf+hcent+5
 beq dsdir1a 
dsdiracc lda #accserr
 jsr syserr
*
dsdir1a sta gbuf+4 ;make it an invalid subdir.
 jsr wrtgbuf
 bcs dsdirerr
dsdir2 lda gbuf+2 ;get forward link.
 cmp gbuf+3 ;test for no link.
 bne dsdir3
 cmp #0
 beq dstlast ;if no link, then finished.
dsdir3 ldx gbuf+3 
 jsr dealloc ;free this block.
 bcs dsdirerr
 lda gbuf+2
 ldx gbuf+3
 jsr rdblk
 bcc dsdir2 ;loop until all are freed.
dsdirerr rts
*
drcpterr lda #cpterr ;file is not compatable.
 jsr syserr ;give up.
*
fcbused equ * ; mark as fcb as dirty so
* the directory will be flushed on 'flush'
 pha 
 tya
 pha ; save regs
 ldy fcbptr 
 lda fcb+fcbdirty,y ; fetch current fcbdirty byte
 ora #fcbmod ; mark fcb as dirty
 sta fcb+fcbdirty,y ; save it back
 pla
 tay ; and restore regs
 pla
 rts
